home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok19 / patterns / patterntest.mod < prev    next >
Text File  |  1993-11-04  |  2KB  |  85 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     PatternTest.mod
  3.     :Contents.      Demonstriert Modul LoPattern und HiPattern
  4.     :Author.      Bernd Preusing
  5.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  6.     :Phone.      04121/22486
  7.     :Copyright.      Public Domain
  8.     :Language.      Modula-2
  9.     :Translator.  M2Amiga V3.2e
  10.     :History.      1.0 14-May-89
  11.     :Imports.      LoPattern, HiPattern, BackDrop (Preusing)
  12.     :Usage.      einfach starten und dann linke Maustaste drücken
  13. ---------------------------------------------------------------------------*)
  14. MODULE PatternTest;
  15.  
  16. FROM SYSTEM    IMPORT    ADR;
  17. FROM BackDrop    IMPORT    OpenBackDrop, CloseBackDrop, BdRp;
  18. FROM Graphics    IMPORT    RastPortPtr, SetAPen, SetBPen, RectFill;
  19. FROM GfxMacros    IMPORT    SetOPen;
  20. IMPORT LoPattern, HiPattern;
  21.  
  22.  
  23. CONST DEPTH = 2;
  24.  
  25.  
  26. PROCEDURE WaitButton;
  27. VAR ciaa[0BFE001H]:SET OF [0..7];
  28. BEGIN
  29.   REPEAT
  30.   UNTIL NOT(6 IN ciaa);
  31.   REPEAT
  32.   UNTIL (6 IN ciaa)
  33. END WaitButton;
  34.  
  35.  
  36. PROCEDURE LoPattTest(rp: RastPortPtr; width,height:INTEGER);
  37. VAR x,y,i,xw,yh, MaxPatt:INTEGER;
  38. CONST Zeilen = 3;
  39. BEGIN
  40.   MaxPatt:=INTEGER(MAX(LoPattern.Pattern));
  41.   SetAPen(rp,1); SetOPen(rp,2);
  42.   xw:=width/(MaxPatt/Zeilen+1);
  43.   yh:=height/Zeilen;
  44.   x:=0; y:=0;
  45.   FOR i:=0 TO MaxPatt DO
  46.     LoPattern.SetPattern(rp,LoPattern.Pattern(i));
  47.     RectFill(rp,x,y,x+xw-1,y+yh-1);
  48.     INC(x,xw); 
  49.     IF x>width-10 THEN x:=0; INC(y,yh) END;
  50.   END;
  51.   WaitButton;
  52. END LoPattTest;
  53.  
  54. PROCEDURE HiPattTest(rp: RastPortPtr; width,height:INTEGER);
  55. VAR x,y,i,xw,yh, MaxPatt:INTEGER;
  56. CONST Zeilen = 3;
  57. BEGIN
  58.   MaxPatt:=INTEGER(MAX(HiPattern.Pattern));
  59.   SetAPen(rp,1); SetOPen(rp,2);
  60.   xw:=width/(MaxPatt/Zeilen+1);
  61.   yh:=height/Zeilen;
  62.   x:=0; y:=0;
  63.   FOR i:=0 TO MaxPatt DO
  64.     HiPattern.SetPattern(rp,HiPattern.Pattern(i));
  65.     RectFill(rp,x,y,x+xw-1,y+yh-1);
  66.     INC(x,xw); 
  67.     IF x>width-10 THEN x:=0; INC(y,yh) END;
  68.   END;
  69.   WaitButton;
  70. END HiPattTest;
  71.  
  72. BEGIN
  73.   OpenBackDrop(DEPTH,640,256,ADR('HiRes'));
  74.   HiPattTest(BdRp,640,256);
  75.   WaitButton;
  76.   CloseBackDrop;
  77.   OpenBackDrop(DEPTH,640,512,ADR('HiRes-Interl'));
  78.   LoPattTest(BdRp,640,512);
  79.   WaitButton;
  80.   CloseBackDrop;
  81.   OpenBackDrop(DEPTH,320,256,ADR('LoRes'));
  82.   LoPattTest(BdRp,320,256);
  83.   WaitButton;
  84. END PatternTest.
  85.